perm filename SC4.F4[M11,LCS] blob sn#439869 filedate 1979-05-08 generic text, type T, neo UTF8
	SUBROUTINE OUTINF
	COMMON /TYP/JOUT,LN,KTYPE
	COMMON /DEVS/ID1,ID21,JTYPE,ID23,ID20
	COMMON/B/MOT,PR,T5,NINS,I,RA,KZY,NWX,INONLY,MX,
	1 Y,Z,FNAME,MZ /D/TF,AMPFAC,OMIT,DURX,IXIN
	DATA SCOR/'SCOR'/,BLA/'   '/ 
	WRITE(JTYPE,117)
	READ(JTYPE,116)AMPFAC,TF,OMIT,DURX
  	IF(TF.EQ.0)TF=1.
  	IF(AMPFAC.EQ.0)AMPFAC=1.
  	IF(DURX.EQ.0)DURX=19999.
115	FORMAT(9I)
116	FORMAT(4F)
112	FORMAT(A4)
118	FORMAT(' TO DSK=1   TTY=2   BOTH=0   LPT=4  '$)
117	FORMAT(' TYPE AMPFAC, TEMPFAC, OMIT, DUR, OR <CR> '$)
113	FORMAT(' OUTPUT NAME? (<CR>="SCOR") '$)
	WRITE(JTYPE,118)
	READ(JTYPE,115)MX,IXIN,INONLY
C MX=WHERE TO SEND OUTPUT, IXIN=RAN NUM, INONLY=INST NUM. TO RUN SINGLE INST.
    	JOUT=5
C  5=OUTPUT TO TTY
	IF(MX.EQ.4)JOUT=3
C MX=4=DIRECT TO LPT 
C MX=10,11,ETC.,22,ETC. SUPPRESSES INPUT LISTING. (33=0)
	KTYPE=0
	IF(MX.LT.10)GO TO 1
	KTYPE=-1
C =-1= DON'T TYPE OUT INPUT FILE.
	MX=MX/11
1 	IF(INONLY.EQ.0)INONLY=-1
	MZ=0
  	GO TO(110,210,310,210,510,610)MX
C 0=DSK,TTY  1=DSK  2=TTY  3=0  4=LPT  5=TTY  6=TTY
310	MZ=-1
110	WRITE(JTYPE,113)
	READ(JTYPE,112)FNAME
	IF(FNAME.EQ.BLA)FNAME=SCOR
   	MX=-1  
	CALL DISKO(ID20,FNAME,4)
  	RETURN 
210	MZ=-1
510	RETURN 
610	MZ=-6
    	RETURN 
C1114	FORMAT('    FOR THE ABOVE YOU MAY TYPE UP TO 3 NUMBERS: N1 N2 N3'//
C	1' N1 = 1 WRITES DATA ON DSK,  =2 WRITES ONLY ON SCREEN,'/
C	1'    = 0 WRITES ON DSK AND SCREEN.'/
C	1'    = 11,22,33 ARE THE SAME AS 1,2,0 BUT INPUT LIST IS NOT
C	1 WRITTEN ON SCREEN.'/
C	1/' N2 = RAN NUM INITIALIZATION.       N3 = DO ONLY INST. #N'/
C	1/' ALSO FOR N1:  N1=5(OR 55)=DURS ONLY (FOR PROOFING)
C	1, =6(OR 66)=DEBUG V ARRAY'//
C	1 3X' UP TO 30 PARAMETERS AND 27 INSTRUMENTS ARE AVAILABLE'/)
	END

C ***** SUBROUTINES TO GO WITH S3X.F4 (RUNIT) *******
C* MICRO, RMOVX, ALL, POINTR, RAND,PARAM  7/78

	FUNCTION RMOVX(W,Y,Z)
	IF(W.EQ.0)W=.01
	IF(Y.EQ.0)Y=.01
	RMOVX=Y*((W/Y)**Z)
	END

	FUNCTION ALL(JPT,IPTX)
	COMMON /VV/LIMIT,V(1)
	DIMENSION JPT(1)
	K=IPTX-1
	IF(K.GT.0)GO TO 2
1    	K=JPT(-K)
	IF(K.LT.0)GO TO 1
C  FOR 'ALL' WITH RR,RD,DF.  FOLLOWS UP ON POINTERS TO POINTERS!
	K=K-1
2	ALL=PARAM(V(K+3),K)
	END

C***** THIS IS NOW A 'FAIL' ROUTINE IN SPRINT.FAI
	FUNCTION PARAM(X,K)
	COMMON J,L  /P/P(1) /PL/IPL(1) /C/T,NWZZ,IT3,T6,NW,TDUR,A,
	1 T2,T4,BY,KODE,NPAR,LP,TBG,AC,NPA,BX,IDF,IPM,NM,PAR,PX2
	K=0
C IF K IS NOT ZERO UPON RETURN, THEN WE'VE FOUND INFO IN OTHER PARAM.
	PARAM=X
	IF(X.GT.-9999.0)RETURN
	IF(X.EQ.-10000.0)RETURN
	K=-(X+9999.0)*100.+.1	
	PARAM=P(K)
C GET DATA FROM PARAM K
	IPM=IPL(K)
	IF(L.NE.2)RETURN
C L=CALLING PARAM NUM., K=PARAM REFERRED TO.
	IF(K.EQ.2)PARAM=PX2
C MUST USE 'UNPROCESSED' FORM OF P2 (I.E. NO 'TEMPO' CHANGES)
	END
	
C***** MICROTONES ********
	SUBROUTINE MICRO
	COMMON INUM,IPAR  /P/P(1) /PL/IPL(2),IPL3 
C   CALL SUBROUTINE FROM ANY PARAMETER WHERE THE CALLING PARAMETER
C   AND THE IMMEDITELY PRECEDING PARAMETER ARE UNUSED BY YOUR INSTR.
C   P3 CAN BE NOTES OR NUMBS.

	X=P(3)
	IF(IPL3.EQ.1)GO TO 1
CC	X=IFIX(X)
C  FOR RAND NOTES TO LOCK ON NOTE NUMBERS.
CC	X=30.8677*2**(X/12)
	X=15.43385*2**(X/12)
C  X=FREQ. IN HZ. BASED ON NT # IN P3.  NUM. ABOVE IS B, IE. LOWEST B -1 OCT.
	IPL3=1
C  THIS CAUSES FREQ. NUM TO PRINT INSTEAD OF LITERAL CHARACTERS.

1	Y=IFIX(P(IPAR-1))
	Z=IFIX(P(IPAR))
C FIX NEEDED BECAUSE OF POSSIBLE NON-INTEGERS HERE.
	P(3)=X*2**(Y/Z)
C  IPAR (Z) IS THE CALLING PARAMETER.  IPAR-1 (Y) THE PREVIOUS PARAM.
C  X HAS BASE FREQ.
C  THE NUMBER IN P(IPAR)=# OF DIVISIONS OF THE OCTAVE.  
C  THE NUMBER IN P(IPAR-1)=CHROMATIC STEP IN THAT DIV.
	END
 
	FUNCTION RAND(A,B)
	COMMON /IRX/IR1,IR2
	RAND=A+(B-A)*RAN(IR1,IR2)
C RAN IS IN FORTRAN LIB.
	END